home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / GCSQUISH.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-06-10  |  14.1 KB  |  415 lines
  1. ;* GCSQUISH.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Compact objects by marking them for relocate        *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18. ;*                                    *
  19. ;*                    ``In nomine omnipotentii dei''    *
  20. ;************************************************************************
  21. IDEAL
  22. %PAGESIZE    60, 132
  23. MODEL   medium
  24. LOCALS  @@
  25. JUMPS
  26.  
  27.     INCLUDE    "scheme.ash"
  28.  
  29. CODESEG
  30.  
  31. ;************************************************************************
  32. ;*              Macro Support for List/Flonum Compaction                *
  33. ;*                                                                      *
  34. ;* Register usage during "move" phase of this routine:                  *
  35. ;*      ax - backward chain header (destination page index)             *
  36. ;*      cx - word count for block move                                  *
  37. ;*      dx - forward chain header (source page index)                   *
  38. ;*      [ds:si] - source list cell                                      *
  39. ;*      [es:di] - destination list cell                                 *
  40. ;************************************************************************
  41. MACRO    sq_fix    OBJTYPE, OBJDEF, FREEOBJTYPE, FREEOBJDEF, objpage
  42. DSTPAGE    EQU    ax
  43. SRCPAGE    EQU    dx
  44.  
  45.     lea    bx, [@@revlist]        ; Create a reverse order linked list of pages
  46.     mov    ax, OBJTYPE
  47.     call    reverse C, bx, ax
  48.     cmp    DSTPAGE, END_LIST     ; is list of pages empty?
  49.     je    @@done
  50.  
  51.     ADJPAGE    DSTPAGE
  52.     mov    SRCPAGE, [objpage]     ; load page number of least dense page
  53.     ADJPAGE SRCPAGE
  54.  
  55.     mov    si, -(SIZE OBJDEF)    ; load source page index
  56. @@findfree:
  57.     cmp    DSTPAGE, SRCPAGE     ; another destination page available ?
  58.     je    @@done
  59.  
  60.     mov    di, DSTPAGE
  61.     mov    di, [nextcell+di]
  62. @@iscellavailable:
  63.     cmp    di, END_LIST
  64.     jne    @@foundfreecell
  65.     mov    di, DSTPAGE
  66.     mov    [nextcell+di], END_LIST
  67.     mov    DSTPAGE, [@@revlist+di]    ; ax <- next page in backward chain
  68.     ADJPAGE DSTPAGE
  69.     jmp    @@findfree
  70.  
  71. @@foundfreecell:
  72.     push    ds
  73. ;************************************************************************
  74. ;* WARNING: The ds Register Doesn't Point to the Data Segment anymore    *
  75. ;************************************************************************
  76.     mov    bx, SRCPAGE          ; Compute end of page boundary
  77.     ldpage    ds, bx
  78.     mov    bx, [ss:psize+bx]
  79.     sub    bx, SIZE OBJDEF
  80. @@finddata:
  81.     add    si, SIZE OBJDEF        ; point to next cell
  82.     cmp    si, bx
  83.     ja    @@endofpage
  84.     cmp    [(FREEOBJDEF ds:si).tag], FREEOBJTYPE
  85.     je    @@finddata
  86.  
  87.     ldpage    es, DSTPAGE
  88.     push    [(FREEOBJDEF es:di).next]
  89. REPT    (SIZE OBJDEF) shr 1
  90.     movsw
  91. ENDM
  92. REPT    (SIZE OBJDEF) and 1
  93.     movsb
  94. ENDM
  95.     sub    si, SIZE OBJDEF     ; back up the source and dest ptrs 
  96.     sub    di, SIZE OBJDEF
  97.     mov    [(OBJDEF ds:si).ptr.page], al
  98.     mov    [(OBJDEF ds:si).ptr.disp], di
  99.     or    [(OBJDEF ds:si).gc], GC_BIT
  100.     pop    di             ; copy next free cell offset into di
  101. ;************************************************************************
  102.     pop    ds
  103.     jmp    @@iscellavailable
  104.  
  105. @@endofpage:                ; Follow forward pointer - get next source page
  106.     pop    ds
  107.     mov    bx, SRCPAGE         ; copy forward chain header to bx
  108.     mov    SRCPAGE, [pagelink+bx]
  109.     ADJPAGE SRCPAGE
  110.  
  111.     mov    si, -(SIZE OBJDEF)
  112.     cmp    DSTPAGE, SRCPAGE
  113.     jne    @@foundfreecell
  114.  
  115.     mov    bx, DSTPAGE             ; update next avail cell ptr in dest page
  116.     mov    [nextcell+bx], di
  117. @@done:
  118.     ENDM
  119.  
  120. ;************************************************************************
  121. ;*                      List Cell Compaction                            *
  122. ;************************************************************************
  123. PROC C    sq_list    USES si di
  124.     LOCAL    @@revlist:WORD:NUMPAGES
  125.     sq_fix    LISTTYPE, LISTDEF, SPECFREE*2, FREELISTDEF, listpage
  126.     ret
  127. ENDP
  128.  
  129. ;************************************************************************
  130. ;*                      Flonum Compaction                               *
  131. ;************************************************************************
  132. PROC C    sq_flo    USES si di
  133.     LOCAL    @@revlist:WORD:NUMPAGES
  134.     sq_fix    FLOTYPE, FLODEF, FREETYPE, FREEFLODEF, flopage
  135.     ret
  136. ENDP
  137.  
  138. ;************************************************************************
  139. ;*              Variable Length Object Compaction                       *
  140. ;*                                                                      *
  141. ;* Register usage during "move" phase of this routine:                  *
  142. ;*      ax - backward chain header (destination page index)             *
  143. ;*      cx - size of block to move                    *
  144. ;*      dx - forward chain header (source page index)                   *
  145. ;*      [ds:si] - source list cell                                      *
  146. ;*      [es:di] - destination list cell                                 *
  147. ;*                                                                      *
  148. ;* Notes:                                                               *
  149. ;*                                                                      *
  150. ;*  1.  Any object which is less than 6 bytes in length cannot be moved *
  151. ;*      because there's no place to put a forwarding pointer.  If a     *
  152. ;*      page is encountered with such an object (e.g., a zero length    *
  153. ;*      vector) that object, and the remaining objects in that page are *
  154. ;*      not copied.  Processing continues with the next source page.    *
  155. ;*                                                                      *
  156. ;*  2.  The current code block cannot be relocated, since the offset    *
  157. ;*      into the current code block is held in register si in most of   *
  158. ;*      the code of the Scheme Virtual Machine emulator.  Since it is   *
  159. ;*      not possible to update this offset, the page containing the     *
  160. ;*      current code block is skipped, if encountered during            *
  161. ;*      compaction.                                                     *
  162. ;************************************************************************
  163. PROC C    sq_var    USES si di, @@type:WORD
  164.     LOCAL    @@pagesize:WORD, @@headptr:WORD, @@revlist:WORD:NUMPAGES
  165. DSTPAGE    EQU    ax
  166. SRCPAGE    EQU    dx
  167.  
  168.     lea    bx, [@@revlist]        ; Create a reverse order linked list of pages
  169.     call    reverse C, bx, [@@type]
  170.     cmp    DSTPAGE, END_LIST     ; is list of pages empty?
  171.     je    @@return
  172.  
  173.     ADJPAGE DSTPAGE         ; convert list header to page index value
  174.     mov    [@@headptr], DSTPAGE     ; save destination list header
  175.  
  176.     mov    bx, [@@type]
  177.     mov    SRCPAGE, [pagelist+bx]     ; load page number of least dense
  178.     ADJPAGE SRCPAGE
  179.     jmp    @@nextsourcepage
  180.  
  181. @@endofpage:                ; Follow forward ptr - get next source page
  182.     mov    bx, SRCPAGE
  183.     mov    SRCPAGE, [pagelink+bx]
  184.     ADJPAGE SRCPAGE
  185. @@nextsourcepage:
  186.     cmp    DSTPAGE, SRCPAGE
  187.     je    @@return
  188.     cmp    SRCPAGE, [cb_reg.page]
  189.     je    @@endofpage
  190.     cmp    SRCPAGE, [regs+0f8h.page]; current inline code block?
  191.     je    @@endofpage
  192.     xor    si, si             ; clear source page index
  193.  
  194. @@finddata:                ; object to move from source page?
  195.     push    ds
  196. ;************************************************************************
  197. ;* WARNING: The ds Register Doesn't Point to the Data Segment anymore    *
  198. ;************************************************************************
  199.     mov    bx, SRCPAGE
  200.     ldpage    ds, bx
  201.     mov    bx, [ss:psize+bx]     ; load the page size and
  202.     sub    bx, OFFSET (TYPE ANYDEF).data ; compute end of page boundary
  203. @@finddataloop:
  204.     cmp    si, bx             ; end of source page?
  205.     jbe    @@spaceleftfordata
  206.     pop    ds
  207.     jmp    @@endofpage
  208. @@spaceleftfordata:
  209.     cmp    [(FREEDEF ds:si).tag], FREETYPE
  210.     jne    @@founddata
  211.     add    si, [(FREEDEF ds:si).len]
  212.     jmp    @@finddataloop
  213.  
  214. @@founddata:
  215.     mov    cx, [(ANYDEF ds:si).len]
  216. ;************************************************************************
  217.     pop    ds
  218.     or    cx, cx             ; check for small string
  219.     jge    @@bigstrdata
  220.     mov    cx, OFFSET (TYPE STRDEF).buffer + SIZE POINTER
  221. @@bigstrdata:
  222.     cmp    cx, OFFSET (TYPE ANYDEF).data + SIZE POINTER; is object "too small" to relocate?
  223.     jb    @@endofpage
  224.     mov    DSTPAGE, [@@headptr]     ; load destination page list header
  225. @@nextfreepage:
  226.     mov    bx, DSTPAGE         ; initialize pointer to dest page
  227.     ldpage    es, bx
  228.     mov    bx, [psize+bx]         ; page size, adjust for boundary check
  229.     sub    bx, OFFSET (TYPE ANYDEF).data
  230.     mov    [@@pagesize], bx
  231.     xor    di, di
  232.     jmp    @@findfreeloop
  233.  
  234. @@findnextfree:
  235.     cmp    [(ANYDEF es:di).len], 0    ; check for small string
  236.     jge    @@bigstrfree
  237.     add    di, OFFSET (TYPE STRDEF).buffer + SIZE POINTER; add the exact length
  238.     jmp    @@findfreeloop
  239. @@bigstrfree:
  240.     add    di, [(ANYDEF es:di).len]
  241. @@findfreeloop:
  242.     cmp    di, [@@pagesize]
  243.     ja    @@endoffreepage
  244.     cmp    [(ANYDEF es:di).tag], FREETYPE
  245.     jne    @@findnextfree
  246.     cmp    cx, [(FREEDEF es:di).len] ; compare sizes
  247.     ja    @@findnextfree        ; too big
  248.     je    @@exactsize
  249.     mov    bx, [(FREEDEF es:di).len]
  250.     sub    bx, cx
  251.     cmp    bx, SIZE FREEDEF
  252.     jb    @@findnextfree        ; no place for a free block
  253.     add    di, cx
  254.     mov    [(FREEDEF es:di).tag], FREETYPE
  255.     mov    [(FREEDEF es:di).len], bx
  256.     sub    di, cx
  257. @@exactsize:
  258.     push    ds
  259. ;************************************************************************
  260. ;* WARNING: The ds Register Doesn't Point to the Data Segment anymore    *
  261. ;************************************************************************
  262.     ldpage    ds, SRCPAGE
  263.     mov    bx, cx             ; remember number of bytes moved
  264.     shr    cx, 1            ; move block by words
  265.     rep    movsw
  266.     jnc    @@moveeven
  267.     movsb
  268. @@moveeven:
  269.     sub    di, bx            ; back up the dest. pointer
  270.     neg    bx            ; - size
  271.     mov    [(ANYDEF ds:si+bx).data.page], al ; store a forwarding pointer
  272.     mov    [(ANYDEF ds:si+bx).data.disp], di
  273.     or    [(ANYDEF ds:si+bx).gc], GC_BIT ; set GC bit to indicate forward
  274. ;************************************************************************
  275.     pop    ds
  276.     jmp    @@finddata
  277.  
  278. @@endoffreepage:
  279.     mov    di, DSTPAGE        ; Find next possible destination page
  280.     mov    DSTPAGE, [@@revlist+di]
  281.     ADJPAGE DSTPAGE
  282.     cmp    DSTPAGE, SRCPAGE    ; another destination page available ?
  283.     jne    @@nextfreepage
  284. @@return:
  285.     ret
  286. ENDP    sq_var
  287.  
  288. ;************************************************************************
  289. ;*            Local Support-- Create Reverse Linked List                *
  290. ;*                                                                      *
  291. ;* Purpose:  To create a reversed copy of the similar page list for     *
  292. ;*              pages of a given type.                                  *
  293. ;*                                                                      *
  294. ;* Calling Sequence:  header = reverse(dest_array, type_index)          *
  295. ;*              header = header pointer of reversed list.               *
  296. ;*              dest_array = array to hold the pointers of the reversed *
  297. ;*                              linked list.                            *
  298. ;*              type_index = type index (type*2) of the page type for   *
  299. ;*                              which the similar page linked list is   *
  300. ;*                              to be reversed (e.g., LISTTYPE causes *
  301. ;*                              the linked list for list cell pages to  *
  302. ;*                              be reversed.                            *
  303. ;************************************************************************
  304.  
  305. PROC C    reverse USES si, @@array, @@type
  306.     mov    bx, [@@array]
  307.     mov    si, [@@type]
  308.     mov    si, [pagelist+si]     ; load list header to appropriate page type
  309.     mov    ax, END_LIST
  310. @@loop:
  311.     cmp    si, END_LIST         ; end of list?
  312.     je    @@return
  313.     mov    dx, si
  314.     ADJPAGE si
  315.     mov    [bx+si], ax         ; reversed array <- prev page number
  316.     mov    si, [pagelink+si]     ; next page
  317.     mov    ax, dx             ; prev page number <- current page number
  318.     jmp    @@loop
  319. @@return:
  320.     ret
  321. ENDP    reverse
  322.  
  323. ;************************************************************************
  324. ;*              Garbage Collection -- Compaction Phase                  *
  325. ;************************************************************************
  326. PROC C  gcsquish USES si di
  327.     LOCAL    @@pagelist:WORD:NUMPAGES, @@freespace:WORD:NUMPAGES
  328.  
  329.     mov    ax, 1            ; display "Garbage Squishing"
  330.     call    gc_on C, ax
  331.     
  332.     lea    bx, [@@freespace]
  333.     call    sum_space C, bx        ; determine available space in each page
  334.  
  335.     push    ds            ; model Small -> ss = ds
  336.     pop    es
  337.     mov    cx, NUMPAGES         ; load page count
  338.     lea    di, [@@pagelist]
  339.     xor    ax, ax             ; initialize page number index
  340.     cld
  341. @@initpagenum:
  342.     stosw
  343.     add    ax, 2             ; increment page index
  344.     loop    @@initpagenum
  345.  
  346.     mov    cx, NUMTYPES        ; reset the similar page type chain headers
  347.     mov    ax, END_LIST
  348.     lea    di, [pagelist]
  349.     rep    stosw
  350.  
  351.     mov    dx, DEDPAGES*2        ; Sort list of pages by available size
  352. @@sortnext:
  353.     mov    si, dx
  354.     mov    di, [@@pagelist+si]
  355.     mov    ax, [@@freespace+di]     ; load amount of space in base page
  356. @@sortmore:
  357.     add    si, 2
  358.     mov    di, [@@pagelist+si]
  359.     cmp    ax, [@@freespace+di]     ; has current page less space?
  360.     jbe    @@sortok
  361.     mov    ax, [@@freespace+di]     ; load size of smaller free space
  362.     mov    di, dx
  363.     mov    cx, [@@pagelist+si]     ; exchange base page index
  364.     xchg    cx, [@@pagelist+di]     ;  with current page index
  365.     mov    [@@pagelist+si], cx
  366. @@sortok:
  367.     cmp    si, (NUMPAGES-1)*2     ; is inner loop complete?
  368.     jl    @@sortmore
  369.     add    dx, 2             ; increment outer loop index
  370.     cmp    dx, (NUMPAGES-1)*2
  371.     jl    @@sortnext
  372.  
  373.     mov    di, DEDPAGES*2
  374. @@similoop:                ; Update the similar page type chains
  375.     mov    si, [@@pagelist+di]
  376.     test    [attrib+si], NOMEMORY
  377.     jnz    @@simidone
  378.     mov    bx, [WORD ptype+si]
  379.     mov    ax, [pagelist+bx]
  380.     mov    [pagelink+si], ax
  381.     mov    ax, si
  382.     corpage    ax
  383.     mov    [pagelist+bx], ax
  384. @@simidone:
  385.     add    di, 2
  386.     cmp    di, NUMPAGES*2
  387.     jl    @@similoop
  388.  
  389.     call    sq_list    C        ; Compact List Cells
  390.     call    sq_flo C         ; Compact Flonums
  391.     mov    ax, BIGTYPE         ; Compact Bignums
  392.     call    sq_var C, ax
  393.     mov    ax, CLOSTYPE         ; Compact Closures
  394.     call    sq_var C, ax
  395.     mov    ax, CODETYPE         ; Compact Code Blocks
  396.     call    sq_var C, ax
  397.     mov    ax, VECTTYPE         ; Compact Vectors
  398.     call    sq_var C, ax
  399.     mov    ax, CONTTYPE         ; Compact Continuations
  400.     call    sq_var C, ax
  401.     mov    ax, SYMBTYPE        ; Compact symbols
  402.     call    sq_var C, ax
  403.     mov    ax, STRTYPE         ; Compact strings
  404.     call    sq_var C, ax
  405.     mov    ax, I86TYPE        ; Compact Inline code
  406.     call    sq_var C, ax
  407.     call    srelocat C        ; relocate all pointers
  408.     call    togglegc C        ; complement the GC (forwarding) bits
  409.     call    gcsweep C        ; reclaim all freed memory
  410.     call    gc_off C
  411.     ret
  412. ENDP    gcsquish
  413.  
  414.     END
  415.